home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tcl70b2.lha / tcl7.0b2 / tests / env.test < prev    next >
Text File  |  1993-06-18  |  4KB  |  117 lines
  1. # Commands covered:  none (tests environment variable implementation)
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1991-1993 The Regents of the University of California.
  8. # All rights reserved.
  9. #
  10. # Permission is hereby granted, without written agreement and without
  11. # license or royalty fees, to use, copy, modify, and distribute this
  12. # software and its documentation for any purpose, provided that the
  13. # above copyright notice and the following two paragraphs appear in
  14. # all copies of this software.
  15. #
  16. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20. #
  21. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26. #
  27. # $Header: /user6/ouster/tcl/tests/RCS/env.test,v 1.6 93/06/18 16:01:08 ouster Exp $ (Berkeley)
  28.  
  29. if {[string compare test [info procs test]] == 1} then {source defs}
  30.  
  31. # If there is no "printenv" program on this system, then it's just too
  32. # much trouble to run this test (can't necessarily run csh to get the
  33. # envionrment:  on some systems it barfs if there isn't a minimum set
  34. # predefined environment variables.  Also, printenv returns a non-zero
  35. # status on some systems, so read the environment using a procedure
  36. # that catches errors.
  37.  
  38. set printenv {}
  39. if [info exists env(PATH)] {
  40.     set dirs [split $env(PATH) :]
  41. } else {
  42.     set dirs {/bin /usr/bin /usr/ucb /usr/local /usr/public /usr/etc}
  43. }
  44. foreach i $dirs {
  45.     if [file executable $i/printenv] {
  46.     set printenv $i/printenv
  47.     break
  48.     }
  49. }
  50. if {$printenv == ""} {
  51.     puts stdout "Skipping env tests:  need \"printenv\" to read environment."
  52.     return ""
  53. }
  54. proc getenv {} {
  55.     global printenv
  56.     catch {exec $printenv} out
  57.     if {$out == "child process exited abnormally"} {
  58.     set out {}
  59.     }
  60.     return $out
  61. }
  62.  
  63. # Save the current environment variables at the start of the test.
  64.  
  65. foreach name [array names env] {
  66.     set env2($name) $env($name)
  67.     unset env($name)
  68. }
  69.  
  70. test env-1.1 {adding environment variables} {
  71.     getenv
  72. } {}
  73.  
  74. set env(NAME1) "test string"
  75. test env-1.2 {adding environment variables} {
  76.     getenv
  77. } {NAME1=test string}
  78.  
  79. set env(NAME2) "more"
  80. test env-1.3 {adding environment variables} {
  81.     getenv
  82. } {NAME1=test string
  83. NAME2=more}
  84.  
  85. set env(XYZZY) "garbage"
  86. test env-1.4 {adding environment variables} {
  87.     getenv
  88. } {NAME1=test string
  89. NAME2=more
  90. XYZZY=garbage}
  91.  
  92. set env(NAME2) "new value"
  93. test env-2.1 {changing environment variables} {
  94.     getenv
  95. } {NAME1=test string
  96. NAME2=new value
  97. XYZZY=garbage}
  98.  
  99. unset env(NAME2)
  100. test env-3.1 {unsetting environment variables} {
  101.     getenv
  102. } {NAME1=test string
  103. XYZZY=garbage}
  104. unset env(NAME1)
  105. test env-3.2 {unsetting environment variables} {
  106.     getenv
  107. } {XYZZY=garbage}
  108.  
  109. # Restore the environment variables at the end of the test.
  110.  
  111. foreach name [array names env] {
  112.     unset env($name)
  113. }
  114. foreach name [array names env2] {
  115.     set env($name) $env2($name)
  116. }
  117.